Visual Basic Source Code/Visual Basic Source Code.iso/vbsource/crwdemo/sorting.frm

Visual Basic Form | 1995-12-05 | 8.1 KB | 283 lines

VERSION 2.00
Begin Form Sort
   BackColor       =   &H00C0C0C0&
   Caption         =   "Record Sort Fields"
   ClientHeight    =   4320
   ClientLeft      =   1500
   ClientTop       =   4110
   ClientWidth     =   7230
   Height          =   5010
   Left            =   1440
   LinkTopic       =   "Form1"
   ScaleHeight     =   4320
   ScaleWidth      =   7230
   Top             =   3480
   Width           =   7350
   Begin CommandButton Command8
      Caption         =   "Help"
      Height          =   375
      Left            =   3000
      TabIndex        =   3
      Top             =   3240
      Width           =   1095
   End
   Begin TextBox Text4
      Height          =   375
      Left            =   1920
      TabIndex        =   14
      Top             =   1800
      Width           =   2055
   End
   Begin CommandButton Command7
      Caption         =   "Set Sort Field"
      Height          =   375
      Left            =   240
      TabIndex        =   18
      Top             =   1800
      Width           =   1335
   End
   Begin TextBox Text3
      Height          =   375
      Left            =   1920
      TabIndex        =   17
      Top             =   1320
      Width           =   2055
   End
   Begin CommandButton Command6
      Caption         =   "Get Sort Field"
      Height          =   375
      Left            =   240
      TabIndex        =   16
      Top             =   1320
      Width           =   1335
   End
   Begin CommandButton Command5
      Caption         =   "# Sort Fields"
      Height          =   375
      Left            =   240
      TabIndex        =   15
      Top             =   855
      Width           =   1335
   End
   Begin TextBox Text2
      Enabled         =   0   'False
      Height          =   375
      Left            =   1920
      TabIndex        =   13
      Top             =   840
      Width           =   2055
   End
   Begin TextBox Text1
      Height          =   375
      Left            =   5520
      TabIndex        =   11
      Top             =   840
      Width           =   855
   End
   Begin CommandButton Command4
      Caption         =   ">>"
      Height          =   375
      Left            =   6000
      TabIndex        =   10
      Top             =   1440
      Width           =   855
   End
   Begin CommandButton Command3
      Caption         =   "<<"
      Height          =   375
      Left            =   5040
      TabIndex        =   9
      Top             =   1440
      Width           =   855
   End
   Begin SSOption Option3D1
      Caption         =   "Descending"
      Height          =   495
      Index           =   1
      Left            =   5160
      TabIndex        =   6
      TabStop         =   0   'False
      Top             =   2880
      Width           =   1335
   End
   Begin SSOption Option3D1
      Caption         =   "Ascending"
      Height          =   495
      Index           =   0
      Left            =   5160
      TabIndex        =   5
      Top             =   2400
      Value           =   -1  'True
      Width           =   1215
   End
   Begin SSPanel Panel3D1
      Alignment       =   1  'Left Justify - MIDDLE
      BevelInner      =   1  'Inset
      BorderWidth     =   1
      Height          =   1335
      Left            =   5040
      TabIndex        =   4
      Top             =   2280
      Width           =   1815
   End
   Begin CommandButton Command2
      Caption         =   "Cancel"
      Height          =   375
      Left            =   1680
      TabIndex        =   2
      Top             =   3240
      Width           =   1095
   End
   Begin CommandButton Command1
      Caption         =   "OK"
      Height          =   375
      Left            =   240
      TabIndex        =   1
      Top             =   3240
      Width           =   1215
   End
   Begin SSPanel StatusBar
      Alignment       =   1  'Left Justify - MIDDLE
      BorderWidth     =   1
      Height          =   495
      Left            =   0
      TabIndex        =   0
      Top             =   3840
      Width           =   7335
   End
   Begin Label Label3
      Alignment       =   2  'Center
      BackColor       =   &H00C0C0C0&
      Caption         =   "Sort Field Number"
      Height          =   255
      Left            =   4920
      TabIndex        =   12
      Top             =   480
      Width           =   1935
   End
   Begin Label Label2
      BackColor       =   &H00C0C0C0&
      Caption         =   "# Sort Fields"
      Height          =   255
      Left            =   1920
      TabIndex        =   8
      Top             =   480
      Width           =   1215
   End
   Begin Label Label1
      BackColor       =   &H00C0C0C0&
      Caption         =   "Sort Direction"
      Height          =   255
      Left            =   5040
      TabIndex        =   7
      Top             =   2040
      Width           =   1215
   End
   Begin Menu MenuFile
      Caption         =   "&File"
      Begin Menu MenuFileExit
         Caption         =   "&Exit"
      End
   End
Dim NumFields As Integer
Sub Command1_Click ()
 Unload Me
End Sub
Sub Command2_Click ()
 Unload Me
End Sub
Sub Command3_Click ()
   Dim nSort As Integer
   If (SortN > 0) Then
      SortN = SortN - 1
      Text1.Text = SortN
   End If
End Sub
Sub Command4_Click ()
   Dim nSorts As Integer
   nSorts = PEGetNSortFields(JobNum)
  If nSorts = 0 Then
     Text1.Text = 0
   Else
     If (SortN < nSorts - 1) Then
    SortN = SortN + 1
    Text1.Text = SortN
     End If
   End If
End Sub
Sub Command5_Click ()
 NumFields = PEGetNSortFields(JobNum)
 If NumFields >= 0 Then
   Sort!StatusBar.Caption = "# of Sort fields Retrieved"
   Text1.Text = 0
   Text2.Text = NumFields
   Else
      RCode = GetErrorString(JobNum)
      MsgBox "PEGetNSortFields Error #: " + Str(ErrorCode) + " - " + RCode
 End If
End Sub
Sub Command6_Click ()
  Dim TextHandle As Integer, TextLength As Integer
  Dim FieldName As String
  If NumFields = 0 Then
   MsgBox ("There are no sort fields to retrieve.")
  Else
   If PEGetNthSortField(JobNum, Text1.Text, TextHandle, TextLength, d%) = False Then
      RCode = GetErrorString(JobNum)
      MsgBox "PEGetNthSortField Error #: " + Str(ErrorCode) + " - " + RCode
    End If
    ' Allocate memory for FieldName
    FieldName = String$(TextLength, " ")
    If PEGetHandleString(TextHandle, FieldName, TextLength) = False Then
      RCode = GetErrorString(JobNum)
      MsgBox "PEGetHandleString Error #: " + Str(ErrorCode) + " - " + RCode
    Else
      Sort!StatusBar.Caption = "Sort field number " + Text1.Text + " has been retrieved"
      Text3.Text = FieldName
    End If
    If d% = 0 Then
      Option3d1(1).Value = True
      Option3d1(0).Value = False
    Else
      Option3d1(0).Value = True
      Option3d1(1).Value = False
    End If
  End If
End Sub
Sub Command7_Click ()
  If Text4.Text = "" Then
    MsgBox "You must enter a field name to set the sort direction!"
  Else
    ' Now Set the sort field with new direction
    If Option3d1(0) = True Then
      d% = 1
    Else
      d% = 0
    End If
    If PESetNthSortField(JobNum, Text1.Text, Text4.Text, d%) = False Then
      RCode = GetErrorString(JobNum)
      MsgBox "PESetNthSortField Error #: " + Str(ErrorCode) + " - " + RCode
    Else
      Sort!StatusBar.Caption = "Sort field number " + Text1.Text + " has been set."
    End If
  End If
End Sub
Sub Command8_Click ()
 RCode = Shell("Winhelp c:\crw\crw.hlp", 3)
 If RCode = False Then
   MsgBox ("RedPoint cannot find the Crystal Help file in C:\CRW directory")
 End If
End Sub
Sub MenuFileExit_Click ()
 Unload Me
End Sub
Sub Option3D1_Click (Index As Integer, Value As Integer)
 'If Option3d1(0).Value Then
 '  Option3d1(1).Value = False
 '  Option3d1(0).Value = True
' Else
 '  Option3d1(0).Value = True
  ' Option3d1(1).Value = False
' End If
End Sub